home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / Morpion 1.0.0 / source / PNL Libraries / MyOOMainLoop.p < prev    next >
Encoding:
Text File  |  1993-12-03  |  24.8 KB  |  1,005 lines  |  [TEXT/PJMM]
  1. unit MyOOMainLoop;
  2.  
  3. interface
  4.  
  5.     const
  6.         WT_NotMine = 'NtMe';
  7.         WT_Generic = 'Genr';
  8.  
  9.     type
  10.         SCType = (SCSave, SCCancel, SCDiscard);
  11.         WObject = object
  12.                 window: dialogPtr;
  13.                 resid: integer;
  14.                 window_type: OSType;
  15.                 window_id: longInt;
  16.                 growRect: rect; { minimum/maximum rect size (for use with grow window) }
  17.                 zoomSize: point; { Optimum zoom size }
  18.                 draw_grow_icon: boolean;
  19.                 is_active: boolean;
  20.                 close_hides_window: boolean;
  21.                 last_event_modifers: integer;
  22.                 procedure JointCreate (id: integer);
  23.                 procedure Create (id: integer);
  24.                 procedure Destroy;
  25.                 procedure GetWindowPos (h: handle);
  26.                 procedure SetWindowPos (h: handle; var wasvisible: boolean);
  27.                 function SaveChanges: SCType;
  28.                 procedure DoClose;
  29. { DoClose checks modified things etc, then calls Destroy }
  30.                 function SetMenuBar: boolean;
  31.                 procedure SetMenus;
  32.                 function EditMenuEnabled: boolean;
  33.                 procedure SetEditMenuItem (item: integer);
  34.                 procedure DoEditMenu (item: integer);
  35.                 function DoMenuKey (er: eventRecord; ch: char): longInt;
  36.                 procedure CalculateRegion (var rgn: rgnHandle);
  37.                 function WaitForEvent (var er: eventRecord; sleep: longInt): boolean;
  38.                 procedure DoIdle;
  39.                 procedure DoDiskEvent (message: longInt);
  40.                 procedure DoSuspendResume (resume: boolean);
  41.                 procedure DoHighLevel (er: eventRecord);
  42.                 procedure DoContent (where: point);
  43.                 procedure DoKey (modifiers: integer; ch: char; code: integer);
  44.                 procedure DoSpecialKey (modifiers: integer; ch: char; code: integer);
  45.                 procedure DoAutoKey (modifiers: integer; ch: char; code: integer);
  46.                 procedure DoDrag (where: point);
  47.                 procedure DoGrow (where: point);
  48.                 procedure Zoom (code: integer);
  49.                 procedure DoZoom (where: point; code: integer);
  50.                 procedure DoGoAway (where: point);
  51.                 procedure DoUpdate;
  52.                 procedure DoMouseMoved (where: point);
  53.                 procedure DrawGrow;
  54.                 procedure DoActivateDeactivate (activate: boolean);
  55.                 procedure Resize;
  56.                 procedure Draw;
  57.                 function DoMainClick (er: eventRecord): boolean;
  58.                 function DoIsDialogEvent (er: eventRecord): boolean;
  59.                 function DoDialogSelect (er: eventRecord; var dlg: dialogPtr; var item: integer): boolean;
  60.                 function HandleSimpleEvents (er: eventRecord): boolean;
  61.                 function HandleEvents (er: eventRecord): boolean;
  62.             end;
  63.         DObject = object(WObject)
  64.                 ok_item, cancel_item: integer;
  65.                 handle_activate_outline: boolean;
  66.                 disable_edit_menu: boolean;
  67.                 procedure Create (id: integer);
  68.                 override;
  69.                 procedure Destroy;
  70.                 override;
  71.                 procedure SetOOOutline (def_item, user_item: integer);
  72.                 procedure DrawOutline;
  73.                 procedure DObject.DoActivateDeactivate (activate: boolean);
  74.                 override;
  75.                 function HandleEvents (er: eventRecord): boolean;
  76.                 override;
  77.                 procedure DoItem (item: integer);
  78.                 procedure DoItemWhere (er: eventRecord; item: integer);
  79.                 procedure DoCancel (modifiers: integer; ch: char; code: integer);
  80.                 procedure DoOK (modifiers: integer; ch: char; code: integer);
  81.             end;
  82.         DTObject = object(DObject)
  83.                 procedure SetEditMenuItem (item: integer);
  84.                 override;
  85.                 function EditMenuEnabled: boolean;
  86.                 override;
  87.                 procedure DoEditMenu (item: integer);
  88.                 override;
  89.                 function DoIsDialogEvent (er: eventRecord): boolean;
  90.                 override;
  91.             end;
  92.  
  93.     var
  94.         default_object: WObject;
  95.  
  96.     function GetWType (wp: windowPtr): OSType;
  97.     function GetWObject (wp: windowPtr): WObject;
  98.     function GetDObject (dlg: dialogPtr): DObject;
  99.     function FrontObject: WObject;
  100.     function IsWObjectFront (o: WObject): boolean;
  101.     function FindWindowID (id: longInt): WObject;
  102.     procedure InitMainLoop (dobj: DObject; domenu: procptr);
  103. { dobj will be used returned with window set to wp whenever GetWObject/GetDObject is called with a DA or nil window }
  104.     procedure FinishMainLoop;
  105. {    procedure DoMenu (themenu, theitem: integer);}
  106.     function InForeground: boolean;
  107.  
  108. implementation
  109.  
  110.     uses
  111.         Script, Processes, MyUtils, MyTypes, MyFMenus, BaseGlobals, MySystemGlobals, {}
  112.         MyTEUtils, MyAssertions, MyDialogs;
  113.  
  114.     const
  115.         titlebar_hight = 18;
  116.  
  117.     type
  118.         WStateDataPtr = ^WStateData;
  119.         WStateDataHandle = ^WStateDataPtr;
  120.  
  121.     const
  122. { from EPPC }
  123.         kHighLevelEvent = 23;
  124.         OOMagic = 'MyOO';
  125.  
  126.     type
  127.         myWindowRecord = record
  128.                 thewindow: windowRecord;
  129.                 magic: OSType;
  130.             end;
  131.         myWindowPtr = ^myWindowRecord;
  132.         myDialogRecord = record
  133.                 thedialog: dialogRecord;
  134.                 magic: OSType;
  135.             end;
  136.         myDialogPtr = ^myDialogRecord;
  137.  
  138. { from AppleEvents }
  139.     function AEProcessAppleEvent (theEventRecord: EventRecord): OSErr;
  140.     inline
  141.         $303C, $021B, $A816;
  142.  
  143.     var
  144.         domenup: procptr;
  145.         last_window_id: longInt;
  146.         in_foreground: boolean;
  147.  
  148.     procedure DoMenu (themenu, theitem: integer; domenu: procptr);
  149.     inline
  150.         $205F, $4E90;
  151.  
  152. {$S Init}
  153.     procedure InitMainLoop (dobj: DObject; domenu: procptr);
  154.         var
  155.             i: integer;
  156.             dummy: boolean;
  157.             dummy_er: eventRecord;
  158.     begin
  159.         for i := 1 to 5 do
  160.             dummy := EventAvail(everyEvent, dummy_er);
  161.         domenup := domenu;
  162.         default_object := dobj;
  163.         dobj.window := nil;
  164.         dobj.JointCreate(0);
  165.         last_window_id := 1;
  166.     end;
  167.  
  168. {$S Term}
  169.     procedure FinishMainLoop;
  170.     begin
  171.         dispose(default_object);
  172.     end;
  173.  
  174. {$S}
  175.     function InForeground: boolean;
  176.         var
  177.             gv: longInt;
  178.             ourpsn, frontpsn: ProcessSerialNumber;
  179.             front: boolean;
  180.     begin
  181.         if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchControl)) then begin
  182.             if (GetCurrentProcess(ourpsn) = noErr) & (GetFrontProcess(frontpsn) = noErr) then begin
  183.                 if SameProcess(ourpsn, frontpsn, front) = noErr then
  184.                     in_foreground := front;
  185.             end;
  186.         end;
  187.         InForeground := in_foreground;
  188.     end;
  189.  
  190.     function GetWRC (wp: windowPtr): WObject;
  191.         var
  192.             rc: longInt;
  193.     begin
  194.         rc := 0;
  195.         if (wp <> nil) & (windowPeek(wp)^.windowKind >= 0) then begin
  196.             if ((windowPeek(wp)^.windowKind = dialogKind) & (myDialogPtr(wp)^.magic = OOMagic)) | (myWindowPtr(wp)^.magic = OOMagic) then
  197.                 rc := GetWRefCon(wp);
  198.         end;
  199.         if rc = 0 then begin
  200.             default_object.window := wp;
  201.             rc := longInt(default_object);
  202.         end;
  203.         GetWRC := WObject(rc);
  204.     end;
  205.  
  206.     function GetWType (wp: windowPtr): OSType;
  207.         var
  208.             wo: WObject;
  209.     begin
  210.         wo := GetWRC(wp);
  211.         if wo = default_object then
  212.             GetWType := WT_NotMine
  213.         else
  214.             GetWType := wo.window_type;
  215.     end;
  216.  
  217.     function GetWObject (wp: windowPtr): WObject;
  218.     begin
  219.         GetWObject := GetWRC(wp);
  220.     end;
  221.  
  222.     function FindWindowID (id: longInt): WObject;
  223.         const
  224.             WindowList = $9D6;
  225.         type
  226.             WindowPtrPtr = ^WindowPtr;
  227.         var
  228.             w: windowPtr;
  229.             wo: WObject;
  230.     begin
  231.         FindWindowID := nil;
  232.         w := WindowPtrPtr(WindowList)^;
  233.         while w <> nil do begin
  234.             wo := GetWObject(w);
  235.             if wo.window_id = id then begin
  236.                 FindWindowID := wo;
  237.                 leave;
  238.             end;
  239.             w := windowPtr(windowPeek(w)^.nextWindow);
  240.         end;
  241.     end;
  242.  
  243.     function GetDObject (dlg: dialogPtr): DObject;
  244.     begin
  245.         GetDObject := DObject(GetWRC(dlg));
  246.     end;
  247.  
  248.     function FrontObject: WObject;
  249.     begin
  250.         FrontObject := GetWRC(FrontWindow);
  251.     end;
  252.  
  253.     function IsWObjectFront (o: WObject): boolean;
  254.     begin
  255.         if o = nil then
  256.             IsWObjectFront := false
  257.         else if o.window = nil then
  258.             IsWObjectFront := false
  259.         else
  260.             IsWObjectFront := o.window = FrontWindow;
  261.     end;
  262.  
  263.     function WObject.SaveChanges: SCType;
  264.         var
  265.             a: integer;
  266.             title: str255;
  267.     begin
  268.         SelectWindow(window);
  269.         GetWTitle(window, title);
  270.         if quitNow then
  271.             ParamText(title, GetGlobalString(quiting_str), '', '')
  272.         else
  273.             ParamText(title, GetGlobalString(closing_str), '', '');
  274.         SetCursor(arrow);
  275.         a := Alert(save_changes_alert_id, nil);
  276.         SaveChanges := SCType(a - 1);
  277.     end;
  278.  
  279.     function WObject.EditMenuEnabled: boolean;
  280.     begin
  281.         if window = nil then
  282.             EditMenuEnabled := false
  283.         else
  284.             EditMenuEnabled := windowPeek(window)^.windowKind < 0
  285.     end;
  286.  
  287.     function WObject.SetMenuBar: boolean;
  288.         var
  289.             oldEditEnabled, editEnabled: boolean;
  290.     begin
  291.         oldEditEnabled := GetIDItemEnable(M_Edit, 0);
  292.         editEnabled := FrontObject.EditMenuEnabled;
  293.         if editEnabled <> oldEditEnabled then
  294.             SetIDItemEnable(M_Edit, 0, editEnabled);
  295.         SetMenuBar := editEnabled <> oldEditEnabled;
  296.     end;
  297.  
  298.     procedure WObject.SetMenus;
  299.     begin
  300.         SetFMenus;
  301.     end;
  302.  
  303.     procedure WObject.SetEditMenuItem (item: integer);
  304.     begin
  305.         if not EditMenuEnabled then
  306.             SetIDItemEnable(M_Edit, item, false);
  307.     end;
  308.  
  309.     procedure WObject.DoEditMenu (item: integer);
  310.         var
  311.             dummyb: boolean;
  312.     begin
  313.         if item <= 6 then
  314.             dummyb := SystemEdit(item - 1);
  315.     end;
  316.  
  317.     function WObject.DoMenuKey (er: eventRecord; ch: char): longInt;
  318.         const
  319.             kMaskVirtualKey = $0000FF00; {get virtual key from event message}
  320.             kMaskASCII1 = $00FF0000;
  321.             kMaskASCII2 = $000000FF; {get key from KeyTrans return}
  322.             kKeyUpMask = $0080;
  323.         var
  324.             h: handle;
  325.             virtualKey, keyCId, state, keyInfo: longInt;
  326.             keycode: integer;
  327.             lowchar, highchar: integer;
  328.     begin
  329.         if BAND(er.modifiers, optionKey) <> 0 then begin
  330.             virtualKey := BSR(BAND(er.message, kMaskVirtualKey), 8);
  331.             keyCode := BOR(BOR(BXOR(er.modifiers, optionKey), kKeyUpMask), virtualKey);
  332.             state := 0;
  333.  
  334.             keyCId := GetScript(GetEnvirons(smKeyScript), smScriptKeys);
  335.             h := GetResource('KCHR', keyCId);
  336.  
  337.             if h <> nil then begin
  338.                 HLock(h); { KeyTrans won't move memory, but lock it anyway to avoid any purgine or foolishness }
  339.                 keyInfo := KeyTrans(h^, keyCode, state);
  340.                 ReleaseResource(h);
  341.                 LowChar := BAND(keyInfo, $FF);
  342.                 HighChar := BAND(BSR(keyInfo, 16), $FF);
  343.                 if lowChar <> 0 then
  344.                     ch := chr(lowChar);
  345.                 if highChar <> 0 then
  346.                     ch := chr(highChar);
  347.             end;
  348.         end;
  349.         DoMenuKey := MenuKey(ch);
  350.     end;
  351.  
  352.     procedure WObject.CalculateRegion (var rgn: rgnHandle);
  353.     begin
  354.         SetCursor(arrow);
  355.         rgn := nil;
  356.     end;
  357.  
  358.     function WObject.WaitForEvent (var er: eventRecord; sleep: longInt): boolean;
  359.         var
  360.             rgn: rgnHandle;
  361.             b: boolean;
  362.     begin
  363.         CalculateRegion(rgn);
  364.         WaitForEvent := WaitNextEvent(everyEvent, er, sleep, rgn);
  365.         if rgn <> nil then
  366.             DisposeRgn(rgn);
  367.     end;
  368.  
  369.     procedure WObject.DoDiskEvent (message: longInt);
  370.         var
  371.             pt: point;
  372.             oe: OSErr;
  373.     begin
  374.         if (HiWord(message) <> noErr) then begin
  375.             pt.h := ((screenbits.bounds.Right - screenbits.bounds.Left - 304) div 2);
  376.             pt.v := ((screenbits.bounds.Bottom - screenbits.bounds.Top - 156) div 3);
  377.             InitCursor;
  378.             oe := DIBadMount(pt, message);
  379.         end;
  380.     end;
  381.  
  382.     procedure WObject.DoSuspendResume (resume: boolean);
  383.     begin
  384.         in_foreground := resume;
  385.         if FrontWindow <> nil then begin
  386.             FrontObject.DoActivateDeactivate(resume);
  387.         end;
  388.         InitCursor;
  389.     end;
  390.  
  391.     procedure WObject.DoHighLevel (er: eventRecord);
  392.         var
  393.             oe: OSErr;
  394.     begin
  395.         if has_AppleEvents then
  396.             oe := AEProcessAppleEvent(er);
  397.     end;
  398.  
  399.     procedure WObject.JointCreate (id: integer); { Called for DefaultObject too! }
  400.     begin
  401.         if window <> nil then begin
  402.             SetWRefCon(window, ord(self));
  403.         end;
  404.         close_hides_window := false;
  405.         growRect := GetGrayRgn^^.rgnBBox;
  406.         growRect.left := 61;
  407.         growRect.top := 61;
  408.         zoomSize.h := 30000;
  409.         zoomSize.v := 30000;
  410.         window_type := WT_Generic;
  411.         draw_grow_icon := false;
  412.         window_id := last_window_id;
  413.         last_window_id := last_window_id + 1;
  414.         resid := id;
  415.     end;
  416.  
  417.     procedure WObject.Create (id: integer);
  418.         var
  419.             wp: myWindowPtr;
  420.     begin
  421.         wp := myWindowPtr(NewPtr(SizeOf(myWindowRecord)));
  422.         wp^.magic := OOMagic;
  423.         window := GetNewWindow(id, ptr(wp), POINTER(-1));
  424.         JointCreate(id);
  425.     end;
  426.  
  427.     procedure WObject.Destroy;
  428.     begin
  429.         if window <> nil then
  430.             DisposeWindow(window);
  431.         if self <> default_object then
  432.             dispose(self);
  433.     end;
  434.  
  435.     type
  436.         savedWindowRecord = record
  437.                 windowpos: rect; { the window position }
  438.                 windowvis: rect; { the visible part of the title bar }
  439.                 zoomed: boolean;
  440.                 visible: boolean;
  441.             end;
  442.         savedWindowPtr = ^savedWindowRecord;
  443.         savedWindowHandle = ^savedWindowPtr;
  444.  
  445.     procedure WObject.GetWindowPos (h: handle);
  446.         var
  447.             rgn: RgnHandle;
  448.             r1, r2: rect;
  449.     begin
  450.         HUnlock(h);
  451.         SetHandleSize(h, SizeOf(savedWindowRecord));
  452.         HLock(h);
  453.         with savedWindowHandle(h)^^ do begin
  454.             SetPort(window);
  455.             visible := windowPeek(window)^.visible;
  456.             windowpos := window^.portRect;
  457.             LocalToGlobal(windowpos.topleft);
  458.             LocalToGlobal(windowpos.botright);
  459.             windowpos.top := windowpos.top - titlebar_hight; { title bar }
  460.             rgn := NewRgn;
  461.             RectRgn(rgn, windowpos);
  462.             SectRgn(GetGrayRgn, rgn, rgn);
  463.             windowvis := rgn^^.rgnBBox;
  464.             DisposeRgn(rgn);
  465.             zoomed := false;
  466.             r1 := window^.portRect;
  467.             LocalToGlobal(r1.topLeft);
  468.             LocalToGlobal(r1.botRight);
  469.             r2 := WStateDataHandle(WindowPeek(window)^.dataHandle)^^.stdState;
  470.             InsetRect(r1, -7, -7);
  471.             zoomed := PtInRect(r2.topLeft, r1) and PtInRect(r2.botRight, r1);
  472.         end;
  473.         HUnlock(h);
  474.     end;
  475.  
  476.     procedure WObject.SetWindowPos (h: handle; var wasvisible: boolean);
  477.         var
  478.             rgn: RgnHandle;
  479.             r: rect;
  480.             dummy: boolean;
  481.     begin
  482.         if (h <> nil) & (GetHandleSize(h) = SizeOf(savedWindowRecord)) then begin
  483.             HLock(h);
  484.             with savedWindowHandle(h)^^ do begin
  485.                 wasvisible := visible;
  486.                 rgn := NewRgn;
  487.                 RectRgn(rgn, windowvis);
  488.                 SectRgn(GetGrayRgn, rgn, rgn);
  489.                 r := rgn^^.rgnBBox;
  490.                 DisposeRgn(rgn);
  491.                 dummy := SectRect(r, windowvis, r);
  492.                 if (longInt(r.topleft) = longInt(windowvis.topleft)) & (longInt(r.botright) = longInt(windowvis.botright)) then begin
  493.                     with windowpos do begin
  494.                         MoveWindow(window, left, top + titlebar_hight, true);
  495.                         SizeWindow(window, right - left, bottom - top - titlebar_hight, true);
  496.                     end;
  497.                 end;
  498.                 if zoomed then
  499.                     Zoom(inZoomOut)
  500.                 else
  501.                     Resize;
  502.             end;
  503.             HUnlock(h);
  504.         end
  505.         else
  506.             wasvisible := true;
  507.     end;
  508.  
  509.     procedure WObject.DoClose;
  510.     begin
  511.         if close_hides_window then
  512.             HideWindow(window)
  513.         else
  514.             Destroy;
  515.     end;
  516.  
  517.     procedure WObject.DoContent (where: point);
  518.     begin
  519.     end;
  520.  
  521.     procedure WObject.DoKey (modifiers: integer; ch: char; code: integer);
  522.     begin
  523.         SysBeep(1);
  524.     end;
  525.  
  526.     procedure WObject.DoSpecialKey (modifiers: integer; ch: char; code: integer);
  527.         var
  528.             item: integer;
  529.     begin
  530.         item := -1;
  531.         if not system7 then begin
  532.             case code of
  533.                 undoKey: 
  534.                     item := EMundo;
  535.                 cutKey: 
  536.                     item := EMcut;
  537.                 copyKey: 
  538.                     item := EMcopy;
  539.                 pasteKey: 
  540.                     item := EMpaste;
  541.                 clearKey: 
  542.                     item := EMclear;
  543.                 otherwise
  544.                     ;
  545.             end;
  546.         end;
  547.         if item <> -1 then begin
  548.             SetMenus;
  549.             if not GetIDItemEnable(M_Edit, 0) or not GetIDItemEnable(M_Edit, item) then
  550.                 item := -1;
  551.         end;
  552.         if item = -1 then
  553.             DoKey(modifiers, ch, code)
  554.         else
  555.             DoMenu(M_Edit, item, domenup);
  556.     end;
  557.  
  558.     procedure WObject.DoAutoKey (modifiers: integer; ch: char; code: integer);
  559.     begin
  560.     end;
  561.  
  562.     procedure WObject.DoDrag (where: point);
  563.         var
  564.             temprect: rect;
  565.             bnds1, bnds2: point;
  566.     begin
  567.         tempRect := GetGrayRgn^^.rgnBBox;
  568.         bnds1 := window^.portBits.bounds.topleft;
  569.         DragWindow(window, where, tempRect);
  570.         bnds2 := window^.portBits.bounds.topleft;
  571.         OffsetRect(WStateDataHandle(WindowPeek(window)^.dataHandle)^^.stdState, bnds1.h - bnds2.h, bnds1.v - bnds2.v);
  572.     end;
  573.  
  574.     procedure WObject.DoGrow (where: point);
  575.         var
  576.             mypt: point;
  577.             oldrect: rect;
  578.             mResult: longInt;
  579.             tempRect: rect;
  580.     begin
  581.         SetPort(window);
  582.         myPt := where;
  583.         GlobalToLocal(myPt);
  584.         oldrect := window^.portRect;
  585.         mResult := GrowWindow(window, where, growRect);
  586.         SizeWindow(window, LoWord(mResult), HiWord(mResult), TRUE);
  587.         SetRect(tempRect, 0, myPt.v - 15, myPt.h + 15, myPt.v + 15);
  588.         EraseRect(tempRect);
  589.         InvalRect(tempRect);
  590.         SetRect(tempRect, myPt.h - 15, 0, myPt.h + 15, myPt.v + 15);
  591.         EraseRect(tempRect);
  592.         InvalRect(tempRect);
  593.         Resize;
  594.     end;
  595.  
  596.     procedure WObject.Zoom (code: integer);
  597.         var
  598.             globalPortRect, theSect, zoomRect: Rect;
  599.             nthDevice, dominantGDevice: GDHandle;
  600.             sectFlag: boolean;
  601.             bias: integer;
  602.             greatestArea, sectArea: longInt;
  603.             tl, br: point;
  604.     begin
  605.         SetPort(window);
  606.         EraseRect(window^.portRect);    {recommended for cosmetic reasons}
  607.         if (code = inZoomOut) then begin
  608.             if has_colorQD then begin
  609.                 globalPortRect := window^.portRect;
  610.                 LocalToGlobal(globalPortRect.topLeft);
  611.                 LocalToGlobal(globalPortRect.botRight);
  612.           { must calculate height of window's title bar }
  613.         { bias := globalPortRect.top - 1 - WindowPeek(window)^.strucRgn^^.rgnBBox.top; }
  614.         {   This doesn't work if the window is invisible, because structRgn is empty, and thus rgnBBox is 0,0,0,0 }
  615.                 bias := titlebar_hight;
  616.                 nthDevice := GetDeviceList;
  617.                 greatestArea := -1;
  618.           { This loop checks the window against all the gdRects in the   }
  619.           { gDevice list and remembers which gdRect contains the largest }
  620.           { portion of the window being zoomed. }
  621.                 while nthDevice <> nil do begin
  622.                     sectFlag := SectRect(globalPortRect, nthDevice^^.gdRect, theSect);
  623.                     with theSect do
  624.                         sectArea := LONGINT(right - left) * (bottom - top);
  625.                     if sectArea > greatestArea then begin
  626.                         greatestArea := sectArea;
  627.                         dominantGDevice := nthDevice;
  628.                     end;
  629.                     nthDevice := GetNextDevice(nthDevice);
  630.                 end; {of WHILE}
  631.           { We must create a zoom rectangle manually in this case. }
  632.           { account for menu bar height as well, if on main device }
  633.                 if dominantGDevice = GetMainDevice then
  634.                     bias := bias + GetMBarHeight;
  635.                 with dominantGDevice^^.gdRect do
  636.                     SetRect(zoomRect, left + 3, top + bias + 3, right - 3, bottom - 3);
  637.             end {of Color QuickDraw conditional stuff}
  638.             else begin
  639.                 zoomRect := WStateDataHandle(WindowPeek(window)^.dataHandle)^^.stdState;
  640.             end;
  641.             tl := window^.portRect.topleft;
  642.             LocalToGlobal(tl);
  643.             br.v := tl.v + zoomSize.v;
  644.             br.h := tl.h + zoomSize.h;
  645.             with zoomRect do begin
  646.                 if PtInRect(tl, zoomRect) and PtInRect(br, zoomRect) then begin
  647.                     zoomRect.topleft := tl;
  648.                     zoomRect.botright := br;
  649.                 end
  650.                 else begin
  651.                     if right - left > zoomSize.h then
  652.                         right := left + zoomSize.h;
  653.                     if bottom - top > zoomSize.v then
  654.                         bottom := top + zoomSize.v;
  655.                 end;
  656.             end;
  657.        { Set up the WStateData record for this window. }
  658.             WStateDataHandle(WindowPeek(window)^.dataHandle)^^.stdState := zoomRect;
  659.         end;
  660.         ZoomWindow(window, code, true);
  661.         Resize;
  662.     end;
  663.  
  664.     procedure WObject.DoZoom (where: point; code: integer);
  665.     begin
  666.         SetPort(window);
  667.         if TrackBox(window, where, code) then
  668.             Zoom(code);
  669.     end;
  670.  
  671.     procedure WObject.DoGoAway (where: point);
  672.     begin
  673.         if TrackGoAway(window, where) then
  674.             DoClose;
  675.     end;
  676.  
  677.     procedure WObject.DoUpdate;
  678.         var
  679.             r: rect;
  680.     begin
  681.         BeginUpdate(window);
  682.         Draw;
  683.         EndUpdate(window);
  684.     end;
  685.  
  686.     procedure WObject.DoMouseMoved (where: point);
  687.     begin
  688.     end;
  689.  
  690.     procedure WObject.DrawGrow;
  691.     begin
  692.         DrawGrowIcon(window);
  693.     end;
  694.  
  695.     procedure WObject.DoActivateDeactivate (activate: boolean);
  696.     begin
  697.         Assert(window <> nil);
  698.         is_active := activate and windowPeek(window)^.visible;
  699.         if is_active then
  700.             SelectWindow(window);
  701.         if draw_grow_icon then
  702.             DrawGrow;
  703.     end;
  704.  
  705.     procedure WObject.Resize;
  706.     begin
  707.         if draw_grow_icon then
  708.             DrawGrow;
  709.     end;
  710.  
  711.     procedure WObject.Draw;
  712.     begin
  713.         if draw_grow_icon then
  714.             DrawGrow;
  715.     end;
  716.  
  717.     function WObject.DoIsDialogEvent (er: eventRecord): boolean;
  718.     begin
  719.         DoIsDialogEvent := IsDialogEvent(er);
  720.     end;
  721.  
  722.     function WObject.DoDialogSelect (er: eventRecord; var dlg: dialogPtr; var item: integer): boolean;
  723.     begin
  724.         DoDialogSelect := DialogSelect(er, dlg, item);
  725.     end;
  726.  
  727.     procedure WObject.DoIdle;
  728.     begin
  729.     end;
  730.  
  731.     function WObject.DoMainClick (er: eventRecord): boolean;
  732.         var
  733.             b: boolean;
  734.             wp: windowPtr;
  735.             mResult: longInt;
  736.             code: integer;
  737.     begin
  738.         b := false;
  739.         code := FindWindow(er.where, wp);
  740.         if (wp <> nil) and (wp <> window) then begin
  741.             if (BAND(er.modifiers, cmdKey) = 0) or (code <> inDrag) then
  742.                 SelectWindow(wp);
  743.             if code = inDrag then
  744.                 GetWObject(wp).DoDrag(er.where);
  745.         end
  746.         else
  747.             case code of
  748.                 inMenuBar:  begin
  749.                     SetMenus;
  750.                     mResult := MenuSelect(er.where);
  751.                     if mResult <> 0 then
  752.                         DoMenu(HiWord(mResult), LoWord(mResult), domenup);
  753.                 end;
  754.                 InDrag: 
  755.                     DoDrag(er.where);
  756.                 inGrow: 
  757.                     DoGrow(er.where);
  758.                 inZoomIn, inZoomOut: 
  759.                     DoZoom(er.where, code);
  760.                 inGoAway: 
  761.                     DoGoAway(er.where);
  762.                 inContent:  begin
  763.                     GlobalToLocal(er.where);
  764.                     DoContent(er.where);
  765.                 end;
  766.                 inSysWindow: 
  767.                     SystemClick(er, window);
  768.                 otherwise
  769.                     b := true;
  770.             end;
  771.         DoMainClick := b;
  772.     end;
  773.  
  774.     function WObject.HandleSimpleEvents (er: eventRecord): boolean;
  775.         var
  776.             b: boolean;
  777.             ch: char;
  778.             mResult: longInt;
  779.     begin
  780.         last_event_modifers := er.modifiers;
  781.         b := false;
  782.         case er.what of
  783.             MouseDown: 
  784.                 b := DoMainClick(er);
  785.  
  786.             KeyDown:  begin
  787.                 ch := chr(BAND(er.message, CharCodeMask));
  788.                 mResult := 0;
  789.                 if BAND(er.modifiers, CmdKey) <> 0 then begin
  790.                     SetMenus;
  791.                     mResult := DoMenuKey(er, ch);
  792.                 end;
  793.                 if mResult <> 0 then
  794.                     DoMenu(HiWord(mResult), LoWord(mResult), domenup)
  795.                 else
  796.                     DoSpecialKey(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100);
  797.             end;
  798.  
  799.             AutoKey: 
  800.                 DoAutoKey(er.modifiers, chr(BAND(er.message, CharCodeMask)), BAND(er.message, keyCodeMask) div $100);
  801.  
  802.             UpdateEvt: 
  803.                 GetWObject(windowPtr(er.message)).DoUpdate;
  804.  
  805.             ActivateEvt: 
  806.                 GetWObject(windowPtr(er.message)).DoActivateDeactivate(odd(er.modifiers));
  807.  
  808.             kOSEvent: 
  809.                 if BAND(BROTL(er.message, 8), $FF) = kSuspendResumeMessage then begin
  810.                     DoSuspendResume(BAnd(er.message, kResumeMask) <> 0);
  811.                 end
  812.                 else if BAND(BROTL(er.message, 8), $FF) = kMouseMovedMessage then begin
  813.                     DoMouseMoved(er.where);
  814.                 end
  815.                 else begin
  816.                     b := true;
  817.                 end;
  818.  
  819.             kHighLevelEvent: 
  820.                 DoHighLevel(er);
  821.  
  822.             DiskEvt: 
  823.                 DoDiskEvent(er.message);
  824.  
  825.             otherwise
  826.                 b := true;
  827.         end;
  828.         HandleSimpleEvents := b;
  829.     end;
  830.  
  831.     function WObject.HandleEvents (er: eventRecord): boolean;
  832.         var
  833.             b: boolean;
  834.             dlg: dialogPtr;
  835.             item: integer;
  836.     begin
  837.         last_event_modifers := er.modifiers;
  838.         DoIdle;
  839.         b := true;
  840.         if DoIsDialogEvent(er) then begin
  841.             if DoDialogSelect(er, dlg, item) then begin
  842.                 GetDObject(dlg).DoItemWhere(er, item);
  843.                 b := false;
  844.             end;
  845.         end;
  846.         if b then begin
  847.             b := HandleSimpleEvents(er);
  848.         end;
  849.         HandleEvents := b;
  850.     end;
  851.  
  852.     procedure DObject.Create (id: integer);
  853.         var
  854.             wp: myDialogPtr;
  855.     begin
  856.         disable_edit_menu := false;
  857.         wp := myDialogPtr(NewPtr(SizeOf(myDialogRecord)));
  858.         wp^.magic := OOMagic;
  859.         window := GetNewDialog(id, ptr(wp), POINTER(-1));
  860.         ok_item := 0;
  861.         cancel_item := 0;
  862.         handle_activate_outline := false;
  863.         JointCreate(id);
  864.     end;
  865.  
  866.     procedure DObject.Destroy;
  867.     begin
  868.         if window <> nil then
  869.             DisposDialog(window);
  870.         if self <> default_object then
  871.             dispose(self);
  872.     end;
  873.  
  874.     procedure OODrawOutline (dp: dialogPtr; item: integer);
  875.         var
  876.             r: rect;
  877.             fi: DObject;
  878.             pstate: PenState;
  879.     begin
  880.         SetPort(dp);
  881.         GetPenState(pstate);
  882.         fi := DObject(GetWObject(dp));
  883.         GetDItemRect(dp, fi.ok_item, r);
  884.         InsetRect(r, -4, -4);
  885.         PenSize(3, 3);
  886.         if not ControlEnabled(dp, fi.ok_item) or not fi.is_active then begin
  887.             PenPat(gray);
  888.             FrameRoundRect(r, 16, 16);
  889.             PenPat(black);
  890.         end
  891.         else
  892.             FrameRoundRect(r, 16, 16);
  893.         SetPenState(pstate);
  894.     end;
  895.  
  896.     procedure DObject.DrawOutline;
  897.     begin
  898.         OODrawOutline(window, ok_item);
  899.     end;
  900.  
  901.     procedure DObject.SetOOOutline (def_item, user_item: integer);
  902.         var
  903.             kind: integer;
  904.             h: handle;
  905.             r: rect;
  906.     begin
  907.         handle_activate_outline := true;
  908.         ok_item := def_item;
  909.         GetDItem(window, user_item, kind, h, r);
  910.         InsetRect(r, -10, -10);
  911.         SetDItem(window, user_item, userItem, handle(@OODrawOutline), r);
  912.     end;
  913.  
  914.     procedure DObject.DoActivateDeactivate (activate: boolean);
  915.     begin
  916.         inherited DoActivateDeactivate(activate);
  917.         if handle_activate_outline then
  918.             OODrawOutline(window, 0);
  919.     end;
  920.  
  921.     procedure DObject.DoOK (modifiers: integer; ch: char; code: integer);
  922.     begin
  923.         if ok_item = 0 then
  924.             DoKey(modifiers, ch, code)
  925.         else begin
  926.             if ControlEnabled(window, ok_item) then begin
  927.                 FlashItem(window, ok_Item);
  928.                 DoItem(ok_item);
  929.             end;
  930.         end;
  931.     end;
  932.  
  933.     procedure DObject.DoCancel (modifiers: integer; ch: char; code: integer);
  934.     begin
  935.         if cancel_item = 0 then
  936.             DoKey(modifiers, ch, code)
  937.         else begin
  938.             FlashItem(window, cancel_Item);
  939.             DoItem(cancel_item);
  940.         end;
  941.     end;
  942.  
  943.     procedure DObject.DoItem (item: integer);
  944.     begin
  945.     end;
  946.  
  947.     procedure DObject.DoItemWhere (er: eventRecord; item: integer);
  948.     begin
  949.         DoItem(item);
  950.     end;
  951.  
  952.     function DObject.HandleEvents (er: eventRecord): boolean;
  953.         var
  954.             b: boolean;
  955.             ch: char;
  956.     begin
  957.         b := true;
  958.         if ((er.what = KeyDown) or (er.what = AutoKey)) then begin
  959.             b := false;
  960.             ch := chr(BAND(er.message, charCodeMask));
  961.             if (ch = chr(13)) or (ch = chr(3)) then
  962.                 DoOK(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100)
  963.             else if (ch = chr(27)) or ((ch = '.') and (BAND(er.modifiers, cmdKey) <> 0)) then
  964.                 DoCancel(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100)
  965.             else
  966.                 b := true;
  967.         end;
  968.         if b then
  969.             b := inherited HandleEvents(er);
  970.         HandleEvents := b;
  971.     end;
  972.  
  973.     procedure DTObject.SetEditMenuItem (item: integer);
  974.     begin
  975.         if disable_edit_menu then
  976.             SetIDItemEnable(M_Edit, item, false)
  977.         else
  978.             TESetEditMenuItem(dialogPeek(window)^.textH, false, 250, item);
  979.     end;
  980.  
  981.     function DTObject.EditMenuEnabled: boolean;
  982.     begin
  983.         if disable_edit_menu then
  984.             EditMenuEnabled := false
  985.         else
  986.             EditMenuEnabled := TEEditMenuEnabled(dialogPeek(window)^.textH, false, 250);
  987.     end;
  988.  
  989.     procedure DTObject.DoEditMenu (item: integer);
  990.         var
  991.             modified: boolean;
  992.     begin
  993.         modified := TEDoEditMenu(dialogPeek(window)^.textH, false, 250, item);
  994.     end;
  995.  
  996.     function DTObject.DoIsDialogEvent (er: eventRecord): boolean;
  997.     begin
  998.         if ((er.what = keyDown) or (er.what = autoKey)) and (BAND(er.modifiers, cmdKey) <> 0) then begin
  999.             DoIsDialogEvent := false; { Stop system 7 from doing the edit menu as well }
  1000.         end
  1001.         else
  1002.             DoIsDialogEvent := inherited DoIsDialogevent(er);
  1003.     end;
  1004.  
  1005. end.